1 Setup

library(NNbenchmark)
library(kableExtra)
library(knitr)
options(scipen = 999)

2 Dataset to test

NNdataSummary(NNbigdatasets)
##   Dataset n_rows n_inputs n_neurons n_parameters
## 1 bWoodN1  20000        6         5           41
ht(bWoodN1)
##              x1         x2        x3        x4        x5        x6          y
## 1     0.5042050 0.05765295 0.9028320 0.4322548 0.4187889 0.3419781 -15.178295
## 2     0.9301722 0.53164816 0.4434929 0.8087859 0.6993847 0.5547075  14.048025
## 3     0.3437977 0.22566605 0.6483183 0.5155759 0.9063721 0.4779758 -20.257463
## 19998 1.0000000 1.00000000 1.0000000 1.0000000 0.0000000 1.0000000  24.227091
## 19999 1.0000000 1.00000000 1.0000000 1.0000000 1.0000000 0.0000000   5.560786
## 20000 1.0000000 1.00000000 1.0000000 1.0000000 1.0000000 1.0000000  24.309251

Check result

if(dir.exists("D:/GSoC2020/Results/2020run05/"))
{  
  odir <- "D:/GSoC2020/Results/2020run05/"
}else if(dir.exists("~/Documents/recherche-enseignement/code/R/NNbenchmark-project/NNbenchmarkTemplates/results_2020_gsoc2020"))
{  
  odir <- "~/Documents/recherche-enseignement/code/R/NNbenchmark-project/NNbenchmarkTemplates/results_2020_gsoc2020"
}else
  odir <- "."

f2test1 <- grep("bWoodN1", list.files(odir, pattern="RData"), value=TRUE)

f2test <- paste0(odir, "/", f2test1)

stopifnot(all(file.exists(f2test)))

3 Results

resultfiles <- paste0(odir, "/", 
                      c("bWoodN1-results-nontop5-per-pkg-column",
                        "bWoodN1-results-per-pkg-column"), ".csv")
bWoodN1_top10 <- cbind(read.csv(resultfiles[1]), read.csv(resultfiles[2])[, -1])

write.csv(bWoodN1_top10, file=paste0(odir, "/", "bWoodN1-results-top10.csv"),
          row.names = FALSE)

4 Graphics

4.1 Plot functions

woodfunc <- function(x, j)
{
  f0 <- function(x) 5*sin(2*pi*x)
  f1 <- function(x) exp(3*x)-7
  f2 <- function(x) 
    0.5*x^11*(10*(1 - x))^6 - 10*(10*x)^3*(1 - x)^10
  f3 <- function(x)
    15*exp(-5*abs(x-1/2))-6
  f4 <- function(x)
    2-(x <= 1/3)*(6*x)^3 - (x >= 2/3)*(6-6*x)^3 - (x > 1/3 & x < 2/3)*(8+2*sin(9*(x-1/3)*pi))
  eta <- 1 + f0(x)+f1(x)+f2(x)+f3(x)+f4(x)+f0(x)
  meta <- mean(eta)
  if(missing(j))
    return(identity(eta))
  etaj <- do.call(paste0("f", j %% 5), list(x))
  etaj+meta
}


controlplot <- function(data, plot.nr, plot.nc, plot.mar=c(4,4,2,1), plot.nobs=1000, 
                        var2round, lwd, theo=TRUE, dolegend=TRUE, ...)
{
  if(var2round)
  {
    par(mfrow=c(plot.nr,plot.nc), mar=plot.mar)
    for(j in 1:(plot.nr*plot.nc))
    {
      Vjb <- round(data[,paste0("x",j)], 2)
      plot(sort(unique(Vjb)), tapply(data$y, Vjb, mean), 
           xlab=paste0("rounded variable ", j), ylab=expression(bar(y)), ...)
      lines(sort(unique(Vjb)), tapply(data$ypred, Vjb, mean), col="red", lwd=lwd)
      curve(woodfunc(x, j), add=TRUE, col="green", lwd=lwd)
      if(dolegend)
      {
        if((j >= 1 && j <= 3) || j == 6) 
          legend("topleft", lty=1, col=c("black","red","green"), 
                 leg=c("emp.", "pred.", "theo."), box.col = NA)
        if(j >= 4 && j <= 5) 
          legend("bottomleft", lty=1, col=c("black","red","green"), 
                 leg=c("emp.", "pred.", "theo."), box.col = NA)
      }
    }
    
  }else
  {
    n <- min(plot.nobs, NROW(data)) 
    par(mfrow=c(plot.nr,plot.nc), mar=plot.mar)
    for(j in 1:(plot.nr*plot.nc))
    {
      plot(data[1:n,paste0("x",j)], data$y[1:n], 
           xlab=paste0("original variable ", j), ylab="y",...)
      points(data[1:n,paste0("x",j)], data$ypred[1:n], col="red")
      if(dolegend)
      {
        if((j >= 1 && j <= 3) || j == 6) 
          legend("topleft", pch=1, col=c("black","red","green"), 
                 leg=c("emp.", "pred.", "theo."), box.col = NA)
        if(j >= 4 && j <= 5) 
          legend("bottomleft", pch=1, col=c("black","red","green"), 
                 leg=c("emp.", "pred.", "theo."), box.col = NA)
      }
    }
  }
  
}

4.2 Graphics

#graphical param
mypch <- 1 #see ?points
mylwd <- 1.25
for(i in 1:length(f2test))
{
  cat(f2test1[i], "\n")
  load(f2test[i])
  idxmin <- which.min(allsummary["RMSE", ])
  cname <- names(idxmin)
  bWoodN1pred <- cbind.data.frame(bWoodN1, ypred=Ypred[, cname])
  
  abserror <- abs(bWoodN1pred[,"y"] - bWoodN1pred[,"ypred"])
  sqerror <- abserror^2
  RMSE <- sqrt(mean(sqerror))
  MAE <- mean(abserror)
  WAE <- max(abserror)
  print(c(RMSE, MAE, WAE))
  
  myoutput <- paste0(substr(f2test[i], 1, nchar(f2test[i])-5), "png")
  mypkg <- strsplit(f2test1[i], "_")[[1]][2]
  mytitle <- paste0(mypkg, " average prediction")
  
  controlplot(bWoodN1pred, 3, 2, var2round = TRUE, pch=mypch, 
            main=mytitle, lwd=mylwd)

  
  png(myoutput, width = 800, height = 600)
  controlplot(bWoodN1pred, 3, 2, var2round = TRUE, pch=mypch, 
            main=mytitle, lwd=mylwd)
  dev.off()

}
## bWoodN1_CaDENCE_cadence.fit_optim.RData 
## [1]  3.366654  2.693465 16.373657

## bWoodN1_h2o_deeplearning_first-order.RData 
## [1]  4.570423  3.713523 16.848604

## bWoodN1_MachineShop_fit_none.RData 
## [1]  3.546748  2.855384 14.164133

## bWoodN1_monmlp_monmlp.fit_BFGS.RData 
## [1]  4.544193  3.704489 17.048286

## bWoodN1_monmlp_monmlp.fit_Nelder-Mead.RData 
## [1]  5.857856  4.683928 29.839449

## bWoodN1_nlsr_nlxb_none.RData 
## [1]  3.548187  2.851494 13.936209

## bWoodN1_nnet_nnet_none.RData 
## [1]  3.549890  2.857267 14.787170

## bWoodN1_radiant.model_nn_none.RData 
## [1] 10.957224  8.768464 42.618832

## bWoodN1_rminer_fit_none.RData 
## [1]  3.366210  2.700794 15.907150

## bWoodN1_traineR_train.nnet_none.RData 
## [1]  3.548788  2.851689 14.025694

## bWoodN1_validann_ann_BFGS.RData 
## [1]  3.359937  2.692919 16.134397